Attribute VB_Name = "FileCopyXCitryx"
Option Explicit
''
Declare Function FindFirstFile Lib "kernel32" Alias _
"FindFirstFileA" (ByVal lpFileName As String, lpFindFileData _
As WIN32_FIND_DATA) As Long
   ''
Declare Function FindNextFile Lib "kernel32" Alias "FindNextFileA" _
(ByVal hFindFile As Long, lpFindFileData As WIN32_FIND_DATA) As Long
''
Declare Function GetFileAttributes Lib "kernel32" Alias _
"GetFileAttributesA" (ByVal lpFileName As String) As Long
''
Declare Function FindClose Lib "kernel32" (ByVal hFindFile As Long) _
As Long
''
Public Const INVALID_HANDLE_VALUE = -1
Public Const FILE_ATTRIBUTE_DIRECTORY = &H10
Public Const MAX_PATH = 260
''
Type WIN32_FIND_DATA
     dwFileAttributes As Long
     ftCreationTime As FILETIME
     ftLastAccessTime As FILETIME
     ftLastWriteTime As FILETIME
     nFileSizeHigh As Long
     nFileSizeLow As Long
     dwReserved0 As Long
     dwReserved1 As Long
     cFileName As String * MAX_PATH
     cAlternate As String * 14
End Type
Public Sub SrArchivosXCitryx()
    Dim stLDestinoPath As String
    Dim stLTipoArchivo As String
    Dim bActualiza As Boolean
    Dim i As Integer
    Dim bLElimina As Boolean
    Dim bLEliminaArchivosDestino As Boolean
    ''-----------------
    Dim bLErrorAlEliminar As Boolean
    Dim MyValue
    Dim stLNuevoDir As String
    Dim stLDirDestino As String
    Dim bLContadorPolizaNewOK As Boolean
    ''
    Dim lnLERRORSQL As Long
    Dim stLERRORSQL As String
    '
    lnLERRORSQL = 0
    stLERRORSQL = ""
    On Local Error GoTo SrArchivosXCitryxErr
    ''
    stLDestinoPath = ""
    stLDestinoPath = Trim(g_Sets("AppPath")) & "\" & Trim(UCase(g_UsuarioTr))
    stLTipoArchivo = ""
    '' --------------------------------------------------------------------------
    '' Elimina archivos, para saber si tiene que crear otra carpeta de trabajo.
    Call SrEliminaArchivosXCytrix(stLDestinoPath, False, bLErrorAlEliminar)
    If bLErrorAlEliminar Then
        '' Si se genero algun error, al eliminar, crea una nueva carpeta.
        ''---------------------------------------------------------------
        '' Genera el nombre aleatoriamente hasta que no se repita.
        ''---------------------------------------------------------------
        Do
            MyValue = Int((1000 * Rnd) + 1)
            stLNuevoDir = ""
            stLNuevoDir = CStr(MyValue)
            stLDirDestino = ""
            stLDirDestino = Trim(g_Sets("AppPath")) & "\" & stLNuevoDir
            If Dir(stLDirDestino, 16) = "" Then
                bLContadorPolizaNewOK = True
            Else
                bLContadorPolizaNewOK = False
            End If
        Loop Until bLContadorPolizaNewOK
        stLDestinoPath = ""
        stLDestinoPath = Trim(g_Sets("AppPath")) & "\" & stLNuevoDir
        '' Crea Directorio.
        If Dir(stLDestinoPath, 16) = "" Then
            MkDir stLDestinoPath
        End If
    End If '' Del If bLErrorAlEliminar Then
    '' --------------------------------------------------------------------------
    If Dir(stLDestinoPath, vbDirectory) = "" Then
        ''Crea la carpeta y inserta los archivos
        MkDir stLDestinoPath
        bLElimina = False
        For i = 1 To 3
            Select Case i
                Case Is = 1
                    stLTipoArchivo = "*.rpt"
                Case Is = 2
                    stLTipoArchivo = "*.mdb"
                Case Is = 3
                    stLTipoArchivo = "*.ini"
            End Select
            bActualiza = bActualizaDirectorio(Trim(g_Sets("AppPath")), stLTipoArchivo, stLDestinoPath, bLElimina, False)
        Next i
    Else
        '' Elimina archivos y luego los actualiza en la carpeta.
        bLElimina = True
        bLEliminaArchivosDestino = False
        For i = 1 To 4
            Select Case i
                Case Is = 1
                    stLTipoArchivo = "*.rpt"
                Case Is = 2
                    stLTipoArchivo = "*.mdb"
                Case Is = 3
                    stLTipoArchivo = "*.ini"
                Case Is = 4
                    stLTipoArchivo = "*.doc"
                    bLEliminaArchivosDestino = True
            End Select
            bActualiza = bActualizaDirectorio(Trim(g_Sets("AppPath")), stLTipoArchivo, stLDestinoPath, bLElimina, bLEliminaArchivosDestino)
        Next i
    End If
    ''
    g_Sets("AppPath") = stLDestinoPath
    ''
    Err = 0
    Call SrCambiaApuntador(g_Pisis32ConstApp.XDEFAULT)
    ''
SrArchivosXCitryxEnd:
    Exit Sub
    ''
SrArchivosXCitryxErr:
    ''
    Call g_AppErro.ShowErrorEx(App.EXEName, Err, Error, "FielCopyXCitryx.Bas.SrArchivosXCitryx", "")
    ''
    Resume SrArchivosXCitryxEnd
End Sub
Public Function StNombre(OriginalStr As String) As String
    If (InStr(OriginalStr, Chr(0)) > 0) Then
       OriginalStr = VBA.Left(OriginalStr, _
        InStr(OriginalStr, Chr(0)) - 1)
    End If
    StNombre = OriginalStr
End Function
Public Function bActualizaDirectorio(stROrigenPath As String, stRTipoArchivo As String, _
    stRDestinoPath As String, bRElimina As Boolean, bREliminaArchivosDestino As Boolean) As Boolean
    Dim inLContador As Integer
    Dim WFD As WIN32_FIND_DATA
    Dim lnLOrigen As Long
    Dim stLNombreArchivo As String
    Dim stLArchivo As String
    Dim stLArchivosOrigen As String
    Dim stLArchivosDestino As String
    Dim lnLERRORSQL As Long
    Dim stLERRORSQL As String
    Dim bLActualiza As Boolean
    ''
    lnLERRORSQL = 0
    stLERRORSQL = ""
    On Local Error Resume Next
    ''
    bLActualiza = False
    If VBA.Right(stROrigenPath, 1) <> "\" Then
        stROrigenPath = stROrigenPath & "\"
    End If
    inLContador = True
    lnLOrigen = FindFirstFile(stROrigenPath & "*", WFD)
    If lnLOrigen <> INVALID_HANDLE_VALUE Then
        Do While inLContador
            stLNombreArchivo = StNombre(WFD.cFileName)
            If (stLNombreArchivo <> ".") And (stLNombreArchivo <> "..") Then
                If GetFileAttributes(stROrigenPath & stLNombreArchivo) And _
                    FILE_ATTRIBUTE_DIRECTORY Then
                    ''
                End If
            End If
            inLContador = FindNextFile(lnLOrigen, WFD) ' next File.
        Loop
        inLContador = FindClose(lnLOrigen)
    End If
    ''
    If bRElimina Then
        lnLOrigen = FindFirstFile(stROrigenPath & stRTipoArchivo, WFD)
        inLContador = True
        If lnLOrigen <> INVALID_HANDLE_VALUE Then
            While inLContador
                stLArchivo = StNombre(WFD.cFileName)
                If (stLArchivo <> ".") And (stLArchivo <> "..") And _
                  ((GetFileAttributes(stROrigenPath & stLArchivo) And _
                   FILE_ATTRIBUTE_DIRECTORY) <> FILE_ATTRIBUTE_DIRECTORY) Then
                    stLArchivosDestino = ""
                    stLArchivosDestino = stRDestinoPath & "\" & stLArchivo
''                    Kill stLArchivosDestino
                End If
                inLContador = FindNextFile(lnLOrigen, WFD)  ' next File
            Wend
            inLContador = FindClose(lnLOrigen)
        End If
    End If
    If bREliminaArchivosDestino Then
        '' Borra los tipos de archivos en el directorio de destino
        '' por ejemplo los .doc, que no se necesitan.
        lnLOrigen = FindFirstFile(stRDestinoPath & "\" & stRTipoArchivo, WFD)
        inLContador = True
        If lnLOrigen <> INVALID_HANDLE_VALUE Then
            While inLContador
                stLArchivo = StNombre(WFD.cFileName)
                If (stLArchivo <> ".") And (stLArchivo <> "..") And _
                  ((GetFileAttributes(stRDestinoPath & "\" & stLArchivo) And _
                   FILE_ATTRIBUTE_DIRECTORY) <> FILE_ATTRIBUTE_DIRECTORY) Then
                    stLArchivosDestino = ""
                    stLArchivosDestino = stRDestinoPath & "\" & stLArchivo
                    Kill stLArchivosDestino
                End If
                inLContador = FindNextFile(lnLOrigen, WFD)  ' next File
            Wend
            inLContador = FindClose(lnLOrigen)
        End If
    End If
    ''
    If Not bREliminaArchivosDestino Then
        lnLOrigen = FindFirstFile(stROrigenPath & stRTipoArchivo, WFD)
        inLContador = True
        If lnLOrigen <> INVALID_HANDLE_VALUE Then
            While inLContador
                stLArchivo = StNombre(WFD.cFileName)
                    If (stLArchivo <> ".") And (stLArchivo <> "..") And _
                      ((GetFileAttributes(stROrigenPath & stLArchivo) And _
                       FILE_ATTRIBUTE_DIRECTORY) <> FILE_ATTRIBUTE_DIRECTORY) Then
                        stLArchivosOrigen = ""
                        stLArchivosOrigen = stROrigenPath & stLArchivo
                        stLArchivosDestino = ""
                        stLArchivosDestino = stRDestinoPath & "\" & stLArchivo
                        FileCopy stLArchivosOrigen, stLArchivosDestino
                    End If
                inLContador = FindNextFile(lnLOrigen, WFD)  ' next File
            Wend
            inLContador = FindClose(lnLOrigen)
        End If
    End If
    ''
    Exit Function
End Function
Sub SrEliminaArchivosXCytrix(stRPathOrigen As String, bRELiminaDir As Boolean, _
bRErrorAlEliminar As Boolean)
    '' Elimina los archivos del directorio de trabajo
    '' y el directorio.
    Dim stLDirDestino As String
    ''
    Dim lnLError As Long
    Dim stLError As String
    '
    lnLError = 0
    stLError = ""
    On Local Error GoTo ERRORSrEliminaArchivosXCytrix
    ''
    bRErrorAlEliminar = False
    stLDirDestino = ""
    stLDirDestino = stRPathOrigen
    If Dir(stLDirDestino, 16) <> "" Then
        ''Elimina los archivos.
        Kill stLDirDestino & "\*.*"
        If bRELiminaDir Then
            RmDir stLDirDestino
        End If
    End If
    ''
    Exit Sub
ERRORSrEliminaArchivosXCytrix:
lnLError = Err
stLError = Error
'' Si el error es diferente de
Select Case lnLError
    Case Is = 53
        '' File Not found
    Case Else
        bRErrorAlEliminar = True
End Select
Err = 0
Resume Next
saleSrEliminaArchivosXCytrix:
End Sub


